The Original Shareware 1.1/The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso/19/bix01.zip/STDMENUS.LIB

Text File | 1986-07-07 | 5KB | 181 lines

             {  Program Name   : Stdmenus.lib                       }
             {  Date Begun     : 10/01/1985                         }
             {  Last Update    : 01/29/1986                         }

             {  Programmer     : Robert L. Hume                     }

             {  Copyright      : Robert L. Hume                     }
             {                 : All rights reserved                }

             {  Language       : Pascal                             }
             {  Implementation : Borland Turbo Pascal Compiler      }

Procedure SMenuFrame;
  var row : Byte;
  Begin
    row:=(Height shr 3);
    WriteAt(1,row,n,Stringof(205,(Width-2)));
    WriteAt((Width shr 2)-2,(row+Menulines),n,Stringof(196,(Width shr 1)+4));
    WriteAt(1,(row+Total_Menulines),n,Stringof(196,Width-2));
  End;
  { ** SMenuFrame ** }

Procedure Title{**(title_center:Byte;s:MenuTitle)**};
 const  Doubleline = 205;
  var   row,adjust : Byte;
  Begin
    row:=(Height shr 3);
    adjust:=(length(s) shr 1);
    if row<2
      then row:=2;
    WriteAt(1,row,n,Stringof(Doubleline,Width-2));
    WriteAt(title_center-adjust,row,h,s);
  End;
  { ** Title ** }

Procedure ShowMenu{**(longest_MenuOp,title_center,first,last:Byte;s:MenuTitle)**};
 const FKeyoffset = 7;
  var  menu_center,
       FNo,Aloc,
       TmpHeight,
       TmpWidth,
       Adjcenter,
       row       : Byte;
       Offset,
       Screen    : Integer;

  procedure CalcMenuVars;
   const MinRow = 4;
    begin
      row:=(succ(Height div 3))-((last-first) shr 1);
      if row < MinRow
        then row:=MinRow;
      menu_center:=(Width shr 1)-((longest_MenuOp+FKeyOffset) shr 1);
      HltMenuR:=row-1;
      HltMenuC:=menu_center+FKeyOffset;
    end;

  procedure PadSetup;
    begin
      Offset:=CalcOffs(1,row);
      TmpHeight:=Height; TmpWidth:=Width;
      Height:=succ(last)-first;
      Width:=HltMenuC+longest_MenuOp;
    end;

  procedure PadWrite;
    begin
      FNo:=1; row:=1;
      Adjcenter:=menu_center+2;
      Screen:=(PadScr*100);
      for Aloc:=first to last do
        begin
          WriteAt(menu_center,Screen+row,h,FKeys[FNo]);
          WriteAt(Adjcenter,Screen+row,n,' ... '+MenuOps[Aloc]);
          row:=row+1;
          FNo:=FNo+1;
        end;
      Recall_Image(PadScr,Offset);
    end;

  Begin
    Title(title_center,s);
    CalcMenuVars;
    PadSetup;
    PadWrite;
    Erase_Screen(PadScr);
    Height:=TmpHeight; Width:=TmpWidth;
  End;
  { ** ShowMenu ** }

Procedure ShowPrompts{**(row,prompt,fkey:Byte)**};
 const AdjCenter = 32;
  var  NewCenter    : Byte;

 Begin
   NewCenter:=(AdjCenter-((length(FKeys[fkey])+length(FKeys[fkey+1])) shr 1));
   NewCenter:=NewCenter-length(Prompts[prompt]);
   GotoXY(1,row); Clreol;
   WriteAt(NewCenter,row,n,Prompts[prompt]);
   WriteAt(WhereX,WhereY,h,'  ['+FKeys[fkey]+']        ['+FKeys[fkey+1]+']  ');
   WriteAt(WhereX,WhereY,n,Prompts[prompt+1]);
 End;
 { ** ShowPrompts ** }

Procedure ShowPrompt{**(row,prompt,fkey:Byte)**};
 const AdjCenter = 39;
  var  NewCenter : Byte;
  Begin
    NewCenter:=AdjCenter-(length(FKeys[fkey]) shr 1);
    GotoXY(1,row); Clreol;
    WriteAt(NewCenter,row,h,'['+FKeys[fkey]+']');
    GotoXY(1,row+1); Clreol;
    WriteAt(0,row+1,n,Prompts[prompt]);
  End;
  { ** ShowPrompt ** }

Procedure ShowMessage{**(OpNo:Byte)**};
 Begin
   GotoXY(1,Message_Line);
   Clreol;
   WriteAt(BaseScr,Message_Line,h,Messages[OpNo]);
 End;
 { ** ShowMessage ** }

Procedure ClrMenu;
  Begin
    Window(1,(succ(Height shr 3)),80,Total_Menulines);
    ClrScr;
    Window(1,1,80,25);
  End;
  { ** ClrMenu ** }

Procedure ClrPrompts;
  Begin
    Window(1,(Message_Line+2),80,25);
    ClrScr;
    Window(1,1,80,25);
  End;
  { ** ClrPrompts ** }

Procedure ClrMessage;
  Begin
   GotoXY(1,Message_Line);
   Clreol;
  End;
  { ** ClrMessage ** }

Procedure ShowMenuResp{**(OptNum,OptRow,VAtt : Byte)**};
  Begin
  if VAtt=1
    then begin
           WriteAt(HltMenuC,HltMenuR+OptRow,h,MenuOps[OptNum]);
           Delay(Wait_Duration shr 1);
           WriteAt(HltMenuC,HltMenuR+OptRow,n,MenuOps[OptNum]);
         end
    else
       WriteAt(HltMenuC,HltMenuR+OptRow,h,MenuOps[OptNum]);
  End;
  { ** ShowMenuResp ** }

Procedure ShowPages{**(LineType,Quan_of_Pages,UpLx,UpLy:Byte)**};
  var hl,vl,tl,tr,bl,br,lj,rj,tj,bj,isect,Pno:Byte;
  Begin
    GotoXY(UpLx,UpLy);
    for Pno:=1 to (Quan_of_Pages-1) do
      begin
        Whichline(LineType,hl,vl,tl,tr,bl,br,lj,rj,tj,bj,isect);
        WriteAt(WhereX,WhereY,n,chr(tl));
        WriteAt(WhereX,WhereY,n,Stringof(hl,24));
        WriteAt(WhereX,WhereY,n,chr(tr));
        WriteAt(WhereX-26,WhereY+1,n,chr(vl));
        WriteAt(WhereX+24,WhereY,n,chr(vl));
        WriteAt(WhereX-26,WhereY+1,n,chr(vl));
        VLine(WhereX-1,WhereY,vl,10);
        WriteAt(WhereX,WhereY,n,chr(bl)+chr(hl));
        GotoXY(WhereX,WhereY-10);
      end;
      Frame(WhereX,WhereY,WhereX+25,WhereY+12,LineType,0);
   End;
   { ** ShowPages ** }